home *** CD-ROM | disk | FTP | other *** search
/ Microsoft Internet Strate…Tools for the Enterprise / Microsoft Internet Strategy & Tools for the Enterprise.iso / content / devel.tls / icp / vbsamp / qukmail.exe / MAILFCNS.BAS < prev   
BASIC Source File  |  1996-03-07  |  9KB  |  190 lines
  1. Attribute VB_Name = "MailFunctions"
  2. Option Explicit
  3. '-------------------------------------------------------
  4. Public Function ParseMessage(msg As String, Group As String, Alias As String) As Boolean
  5. '-------------------------------------------------------
  6.     Dim strStart As Long
  7.     Dim strEnd As Long
  8.     Dim Body As String
  9. '-------------------------------------------------------
  10.     strStart = InStr(1, msg, vbCrLf & vbCrLf & vbCrLf) + 6
  11.     If (strStart > 6) Then
  12.         strEnd = InStr(strStart, msg, vbCrLf & "." & vbCrLf) + 1
  13.         If (strEnd > 0) Then
  14.             Body = Mid(msg, strStart, strEnd - strStart + 1)
  15.             strEnd = InStr(1, Body, vbCrLf) - 1
  16.             If (strEnd > 0) Then
  17.                 Group = Mid(Body, 1, strEnd)
  18.                 strStart = strEnd + 3
  19.                 strEnd = InStr(strStart, Body, vbCrLf) - 1
  20.                 If (strEnd > 0) Then
  21.                     Alias = Mid(Body, strStart, strEnd - strStart + 1)
  22.                     ParseMessage = True
  23.                 End If
  24.             End If
  25.         End If
  26.     End If
  27. '-------------------------------------------------------
  28. End Function
  29. '-------------------------------------------------------
  30.  
  31. '-------------------------------------------------------
  32. Public Function BuildDatabase(NewDbName As String, ParamArray ObjScripts() As Variant) As Boolean
  33. '-------------------------------------------------------
  34.     Dim DB As Database                                  ' Database
  35.     Dim RS As Recordset                                 ' Record set
  36.     Dim SQL As Long                                     ' ObjScripts index variable
  37. '-------------------------------------------------------
  38.     If (Dir(NewDbName) <> "") Then Exit Function        ' Database already exists Exit
  39.     
  40.     On Error GoTo CleanUp                               ' Handle errors...
  41.     Screen.MousePointer = vbHourglass
  42.     
  43.     Set DB = CreateDatabase(NewDbName, dbLangGeneral, dbVersion30)    ' Create new database
  44.  
  45.     For SQL = LBound(ObjScripts) To UBound(ObjScripts)  ' For each sql script parameter
  46.         DB.Execute ObjScripts(SQL), dbSQLPassThrough    ' Execute sql script
  47.     Next                                                ' Next parameter
  48. '-------------------------------------------------------
  49. CleanUp:                                                ' Clean up workspace...
  50. '-------------------------------------------------------
  51.     If Not (DB Is Nothing) Then DB.Close                ' Close database connection
  52.     Set DB = Nothing                                    ' Destory db object
  53.     
  54.     Screen.MousePointer = vbDefault
  55. '-------------------------------------------------------
  56. End Function
  57. '-------------------------------------------------------
  58.  
  59. '-------------------------------------------------------
  60. Public Sub AddAliasToDatabase(DBName As String, Group As String, Alias As String)
  61. '-------------------------------------------------------
  62.     Dim DB As Database                              ' Database
  63.     Dim RS As Recordset                             ' Record set
  64. '-------------------------------------------------------
  65.     Screen.MousePointer = vbHourglass
  66.     
  67.     On Error Resume Next                            ' Handle error in case Group already exists...
  68.     Set DB = OpenDatabase(DBName)
  69.     Set RS = DB.OpenRecordset("addresses", dbOpenTable) ' Open recordset...
  70.     
  71.     With RS
  72.         .AddNew                                     ' Insert new record
  73.         .Fields("groupname") = Group                ' Add Group
  74.         .Fields("alias") = ""                       '
  75.         .Update                                     ' Save changes.
  76.         .AddNew                                     ' Insert new record
  77.         .Fields("groupname") = Group                ' Add Group
  78.         .Fields("alias") = Alias                    ' Add Alias
  79.         .Update                                     ' Save changes.
  80.     End With
  81.     
  82.     RS.Close                                        ' Close record set
  83.     Set RS = Nothing                                ' Destroy record set object
  84.     DB.Close                                        ' Close database connection
  85.     Set DB = Nothing                                ' Destory db object
  86.     
  87.     Screen.MousePointer = vbDefault
  88. '-------------------------------------------------------
  89. End Sub
  90. '-------------------------------------------------------
  91.  
  92. '-------------------------------------------------------
  93. Public Sub AddAliasesToTree(Tree As TreeView, DBName As String)
  94. '-------------------------------------------------------
  95.     Dim DB As Database                              ' Database
  96.     Dim RS As Recordset                             ' Record set
  97. '-------------------------------------------------------
  98.     Screen.MousePointer = vbHourglass
  99.     
  100.     On Error Resume Next                            ' Handle error in case Group already exists...
  101.     Set DB = OpenDatabase(DBName)
  102.     Set RS = DB.OpenRecordset("addresses", dbOpenTable) ' Open recordset...
  103.     
  104.     With RS
  105.         Do While Not .EOF
  106.             Call AddAliasToTree(Tree, .Fields("groupname"), .Fields("alias"))
  107.             .MoveNext
  108.         Loop
  109.     End With
  110.     
  111.     RS.Close                                        ' Close record set
  112.     Set RS = Nothing                                ' Destroy record set object
  113.     DB.Close                                        ' Close database connection
  114.     Set DB = Nothing                                ' Destory db object
  115.     
  116.     Screen.MousePointer = vbDefault
  117. '-------------------------------------------------------
  118. End Sub
  119. '-------------------------------------------------------
  120.  
  121. '-------------------------------------------------------
  122. Public Sub AddAliasToTree(Tree As TreeView, Group As String, Alias As String)
  123. '-------------------------------------------------------
  124.     Dim NodeR As Node
  125.     Dim NodeP As Node
  126.     Dim NodeC As Node
  127. '-------------------------------------------------------
  128.     With Tree
  129.         Set NodeR = .Nodes(1)                       ' Grab root node...
  130.         
  131.         On Error Resume Next                        ' Handle duplicate name entries...
  132.         
  133.         Set NodeP = .Nodes(Group)
  134.         If (NodeP Is Nothing) Then
  135.             Set NodeP = .Nodes.Add(NodeR, tvwChild, Group, Group, icoGROUP)
  136.         End If
  137.                 
  138.         If (Alias <> "") Then
  139.             Set NodeC = .Nodes(Group & Alias)
  140.             If (NodeC Is Nothing) Then
  141.                 Set NodeC = .Nodes.Add(NodeP, tvwChild, Group & Alias, Alias, icoALIAS)
  142.             End If
  143.         End If
  144.     End With
  145. '-------------------------------------------------------
  146. End Sub
  147. '-------------------------------------------------------
  148.  
  149. '-------------------------------------------------------
  150. Public Sub DeleteAliases(Tree As TreeView, DBName As String)
  151. '-------------------------------------------------------
  152.     Dim DB As Database                              ' Database
  153.     Dim RS As Recordset                             ' Record set
  154.     Dim Group As String                             ' Email Group
  155.     Dim Alias As String                             ' Email Alias
  156.     Dim NodeC As Node                               ' Current node
  157. '-------------------------------------------------------
  158.     Set NodeC = Tree.SelectedItem
  159.     Group = NodeC.Key                               ' Get Node Key[groupname or groupname\alias]
  160.     Alias = NodeC.Text                              ' Get Node Text[groupname or alias]
  161.     If (Group = "") Or (Group = MAILGROUPROOT) Then Exit Sub ' Valdiate node key
  162.     
  163.     Screen.MousePointer = vbHourglass
  164.     '-------------------------------------------------------
  165.     ' Delete group\alias from database
  166.     '-------------------------------------------------------
  167.     Set DB = OpenDatabase(DBName)                   ' Open database
  168.     
  169.     If (Group = Alias) Then                         ' Node is group
  170.         ' Delete group from database
  171.         DB.Execute "delete * from addresses where groupname = """ & Group & """"
  172.         Tree.Nodes.Remove Group                     ' Delete group/s from tree...
  173.     Else                                            ' Node is alias only
  174.         Group = NodeC.Parent.Text
  175.         
  176.         ' Delete alias from database
  177.         DB.Execute "delete * from addresses where alias = """ & Alias & """" & _
  178.                                         " and groupname = """ & Group & """"
  179.         Tree.Nodes.Remove Group & Alias             ' Delete alias from tree...
  180.     End If
  181.     
  182.     DB.Close                                        ' Close database connection
  183.     Set DB = Nothing                                ' Destory db object
  184.     
  185.     Screen.MousePointer = vbDefault
  186. '-------------------------------------------------------
  187. End Sub
  188. '-------------------------------------------------------
  189.  
  190.